home *** CD-ROM | disk | FTP | other *** search
-
- /* Randomcopy.e COPYRIGHT 1993 by Chad Randall (crandall) */
-
-
- MODULE 'dos/dos','dos/dosextens','dos/dosasl','exec/tasks'
-
-
- /* Sorry, I like global variables. Could be from 10 years of Basic/asm...*/
-
- DEF source[150]:STRING
- DEF dest[150]:STRING
- DEF work[150]:STRING
- DEF work2[150]:STRING
- DEF argarray[16]:LIST
-
- DEF userndfile=FALSE,fha=0,bb=0
- DEF i,t,quietflag,cloneflag,seconds,micros,random,dd,ticksflag,waittime,longbreak
- DEF rdarg,noreqflag,minwait,maxwait,buffersize=512
-
- DEF workfh=NIL:PTR TO filehandle,
- destfh=NIL:PTR TO filehandle
- DEF apath=NIL:PTR TO anchorpath
-
- DEF datestamp=NIL:PTR TO datestamp,comment[100]:STRING,condom
-
- CONST AOK=69 /* GRIN 8-> */
- CONST NOT_AOK=666 /* Just a joke... or is it? >:"> */
-
- ENUM ERR_NONE,ERR_INCORRECT,ERR_DOS,ERR_NOSOURCE,ERR_NODEST,ERR_MINMIN,ERR_MINMAX,
- ERR_MAXMIN,ERR_MAXMAX,ERR_MIN_MORE_MAX,ERR_BUFFER_TO_SMALL,ERR_NOMEM,
- ERR_CTRLC
-
- RAISE ERR_CTRLC IF CtrlC ()=TRUE
-
- PROC main() HANDLE
-
- IF KickVersion(37)=NIL
- WriteF('\nGet OS2.x (maybe a nice A1200?)\n')
- CleanUp(21)
- ENDIF
-
- IF FreeStack()<3000 /*I can't seem to test this. E seems to*/
- WriteF('Not enough free stack space.\n') /* have it's own stack?*/
- CleanUp(21)
- ENDIF
-
- CurrentTime({seconds},{micros})
-
- random:=RndQ(seconds)
-
- /* An attempt to get a pseudo-randomized number! */
- /*Let's hope this doesn't slow down too bad on non '30 machines...*/
-
- CurrentTime({seconds},{micros})
-
- FOR i:=0 TO micros/1000
- dd:=Rnd(i)
- ENDFOR
-
- rdarg:=ReadArgs('FROM/A,TO/A,MIN=MINWAIT/N,MAX=MAXWAIT/N,UT=USETICKS/S,LB=LONGBREAK/S,QUIET/S,CLONE/S,NOREQ/S,BUF=BUFFER/K/N,RNDFILE/S,ABOUT/S',argarray,0)
-
- IF rdarg>0
- IF argarray[0]<>NIL
- StrCopy(source,argarray[0],ALL)
- ENDIF
- IF argarray[1]<>NIL
- StrCopy(dest,argarray[1],ALL)
- ENDIF
- IF argarray[2]<>NIL
- minwait:=argarray[2]
- minwait:=^minwait
- IF (minwait<1) THEN Raise(ERR_MINMIN)
- IF (minwait>9999) THEN Raise(ERR_MINMAX)
- ENDIF
- IF argarray[3]<>NIL
- maxwait:=argarray[3]
- maxwait:=^maxwait
- IF (maxwait<2) THEN Raise(ERR_MAXMIN)
- IF (maxwait>10000) THEN Raise(ERR_MAXMAX)
- IF (maxwait<=minwait) THEN Raise(ERR_MIN_MORE_MAX)
- ENDIF
- IF argarray[4]<>NIL
- ticksflag:=TRUE
- ENDIF
- IF argarray[5]<>NIL
- longbreak:=TRUE
- ENDIF
- IF argarray[6]<>NIL
- quietflag:=TRUE
- ENDIF
- IF argarray[7]<>NIL
- cloneflag:=TRUE
- ENDIF
- IF argarray[8]<>NIL
- noreqflag:=TRUE
- ENDIF
- IF argarray[9]<>NIL
- buffersize:=argarray[9]
- buffersize:=^buffersize
- IF (buffersize=0 OR buffersize>65000)
- Raise(ERR_BUFFER_TO_SMALL)
- ENDIF
- ENDIF
- IF argarray[10]<>NIL
- userndfile:=TRUE
- ENDIF
- IF argarray[11]<>NIL
- instructions()
- ENDIF
- FreeArgs(rdarg)
- ELSE
- Raise(ERR_DOS)
- ENDIF
-
- CtrlC()
-
- bb:=[0,0,0,0,0,0,0]:LONG
- IF (userndfile)
- fha:=Open('s:randomcopy.seed',MODE_OLDFILE)
- IF fha
- Read(fha,bb,4)
- random:=RndQ(Long(bb))
- Close(fha)
- ENDIF
- ENDIF
- docopy()
- IF (userndfile)
- fha:=Open('s:randomcopy.seed',MODE_NEWFILE)
- IF fha
- random:=RndQ(random);random:=RndQ(random);random:=RndQ(random)
- PutLong(bb,random)
- Write(fha,bb,4)
- Close(fha)
- ENDIF
- ENDIF
- IF (minwait OR maxwait)
- IF (maxwait<minwait)
- maxwait:=minwait
- ENDIF
- IF ticksflag=NIL
- minwait:=minwait*50
- maxwait:=maxwait*50
- ENDIF
- WHILE TRUE<>FALSE /* Will be broken by Ctrl-C ONLY! */
- waittime:=maxwait-minwait+1
- waittime:=Rnd(waittime)
- waittime:=waittime+minwait
- CtrlC()
- IF ((waittime<100) OR (longbreak))
- Delay(waittime)
- ELSE
- t:=waittime/100
- FOR i:=0 TO t
- CtrlC()
- Delay(100)
- ENDFOR
- t:=waittime-(t*100)
- Delay(t)
- ENDIF
- docopy()
- ENDWHILE
- ENDIF
-
- EXCEPT
-
- SELECT exception
- CASE ERR_INCORRECT
- quietprint('incorrect arguments')
- CASE ERR_DOS
- IF quietflag=NIL
- PrintFault(IoErr(),'randomcopy')
- ENDIF
- CASE ERR_MINMIN
- quietprint('minimum wait is too small')
- CASE ERR_MINMAX
- quietprint('minimum wait is too large')
- CASE ERR_MAXMIN
- quietprint('maximum wait is too small')
- CASE ERR_MAXMAX
- quietprint('maximum wait is too large')
- CASE ERR_MIN_MORE_MAX
- quietprint('minimum is greater than maximum')
- CASE ERR_BUFFER_TO_SMALL
- quietprint('illegal buffersize size')
- CASE ERR_NOMEM
- quietprint('not enough memory available')
- CASE ERR_CTRLC
- quietprint('***Break')
- ENDSELECT
- IF (apath) THEN MatchEnd(apath);apath:=NIL
- IF (destfh) THEN Close(destfh);destfh:=NIL /* Try to make sure we unlock all */
- IF (workfh) THEN Close(workfh);workfh:=NIL
- CleanUp(11)
-
- ENDPROC
-
- PROC quietprint(str)
- IF quietflag=NIL
- WriteF('randomcopy: \s\n',str)
- ENDIF
- ENDPROC
-
- PROC docopy()
- DEF fileinfo=NIL:PTR TO fileinfoblock
- DEF achain=NIL:PTR TO achain
- DEF err,pathlen,filestart,first,chance=1
- DEF newdate=NIL:PTR TO datestamp
-
- filestart:=FilePart(source)
- pathlen:=filestart-source
- IF (pathlen)
- StrCopy(work,source,pathlen)
- ELSE
- StrCopy(work,'',ALL)
- ENDIF
-
- apath:=New(SIZEOF anchorpath)
- datestamp:=New(SIZEOF datestamp)
-
- /* fileinfo:=New(SIZEOF fileinfoblock) */
-
- err:=NIL;first:=FALSE
- WHILE err=NIL
- CtrlC()
- IF first=FALSE
- err:=MatchFirst(source,apath)
- first:=TRUE
- ELSE
- err:=MatchNext(apath)
- ENDIF
- IF (err)
- IF (err=ERROR_NO_MORE_ENTRIES)
- IF chance>1
- copyfile()
- ELSE
- Raise(ERR_DOS)
- ENDIF
- ELSE
- Raise(ERR_DOS)
- ENDIF
- ELSE
- achain:=apath.last
- IF (achain)
- fileinfo:=achain.info
- IF (fileinfo.direntrytype)<0
- IF (fileinfo)
- IF(Rnd(chance))=NIL
- StrCopy(work2,fileinfo.filename,ALL)
- IF cloneflag
- StrCopy(comment,fileinfo.comment,ALL)
- condom:=fileinfo.protection
- newdate:=fileinfo.datestamp
- datestamp.days:=newdate.days
- datestamp.minute:=newdate.minute
- datestamp.tick:=newdate.tick
- ENDIF
- ENDIF
- chance:=chance+1
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDWHILE
-
- MatchEnd(apath);apath:=NIL
-
- ENDPROC
-
- PROC copyfile()
- DEF filesize
- DEF cont=FALSE,numbytes,buffer,numbytes2
-
- buffer:=New(buffersize)
- IF (buffer=0)
- Raise(ERR_NOMEM)
- ENDIF
- StrAdd(work,work2,ALL)
- IF quietflag=NIL
- WriteF('Copying \s TO \s\n',work,dest)
- ENDIF
- CtrlC()
- IF(filesize:=FileLength(work))>0
- CtrlC()
- IF (workfh:=Open(work,MODE_OLDFILE))
- CtrlC()
- IF (destfh:=Open(dest,MODE_NEWFILE))
- WHILE cont=FALSE
- CtrlC()
- numbytes:=Read(workfh,buffer,buffersize)
- IF numbytes=-1
- Raise(ERR_DOS)
- ELSE
- IF numbytes=0
- cont:=TRUE
- ELSE
- numbytes2:=Write(destfh,buffer,numbytes)
- IF numbytes<buffersize
- cont:=TRUE
- ENDIF
- ENDIF
- ENDIF
- ENDWHILE
- ELSE
- Raise(ERR_DOS)
- ENDIF
- ELSE
- Raise(ERR_DOS)
- ENDIF
- ELSE
- Raise(ERR_DOS)
- ENDIF
- IF (destfh) THEN Close(destfh);destfh:=NIL
- IF (workfh) THEN Close(workfh);workfh:=NIL
- IF cloneflag
- IF (SetFileDate(dest,datestamp))=FALSE THEN Raise(ERR_DOS)
- IF (SetComment(dest,comment))=FALSE THEN Raise(ERR_DOS)
-
- /* V V V -ALWAYS a good idea!!! */
- IF (SetProtection(dest,condom))=FALSE THEN Raise(ERR_DOS)
- ENDIF
-
- ENDPROC
-
- PROC instructions()
- IF quietflag=NIL
- WriteF('\nRandomcopy version .90 December 28, 1993.\n')
- WriteF('This program is copyright ®1993 by Chad Randall\n')
- WriteF('and may be freely distributed.\n')
- WriteF('\n')
- WriteF(' EMAIL:crandall@garnet.msen.com\n')
- WriteF(' USNAIL:Chad Randall, 229 S.Washington St.,\n')
- WriteF(' Manchester, Michigan 48158-9680, USA.\n')
- WriteF('\n')
- ENDIF
- ENDPROC
-
- CHAR '$VER: randomcopy 0.90 © 1993 Chad Randall (28.12.93)',0
-